unit Geometry;

interface
uses
Vectors2, Supply, AsphyreDef, Math;

function LineWithLine(ps1,pe1,ps2,pe2:Tpoint2; out r:Tpoint2):boolean;
function LineWithSphere(p1,p2,RPos:TPoint2; R:Real; out r1,r2:TPoint2):integer;
function LineWithQuad(p1,p2:TPoint2; Quad:TPoint4; out r1,r2:TPoint2):integer;
function FirstPoint(a,b,c:TPoint2):TPoint2;
function SphereWithRect(x1,y1,r:real;FRect2:TRect2):boolean;
function SphereWithQuad(x1,y1,r:real;Quad:TPoint4):boolean;
function PtInQuad(Pt:TPoint2;Quad:TPoint4):boolean;
function DistFromPtToLine(Pt:TPoint2;A,B:TPoint2):real;
function Sin256(i: real): Double;
function Cos256(i: real): Double;
procedure InitCosinTable;
function GetAngle(x1,y1,x2,y2:real):real;
function CInC(x1,y1,r1,x2,y2,r2:real;Intersect:boolean):boolean;
function PtInCircle(x,y,x1,y1,r1:real):boolean;
function PtInRect2(Rect:TRect2;P:TPoint2):boolean;
function LineLength(x1,y1,x2,y2:real):real;
function Rect2(left,top,right,bottom:real):TRect2;
function Bounds2(ALeft,ATop,AWidth,AHeight:real):TRect2;
function LineOverlapRect(const Point1,
   Point2: TPoint2; const Rect: TRect2): Boolean;
function RectInRect2(const Rect1, Rect2: TRect2): Boolean;
function OverlapRect2(const Rect1, Rect2: TRect2): Boolean;

implementation
var
CosinTable: array[0..255] of Double;

function LineWithLine(ps1,pe1,ps2,pe2:Tpoint2; out r:Tpoint2):boolean;
var
m1,m2,b1,b2:real;
begin
  result:=true;
  if (ps1.x=pe1.x)or(ps2.x=pe2.x) then
  begin
    result:=false;
    exit;
  end;

  m1:=(ps1.y-pe1.y)/(ps1.x-pe1.x);
  m2:=(ps2.y-pe2.y)/(ps2.x-pe2.x);
  b1:=ps1.y-ps1.x*m1;
  b2:=ps2.y-ps2.x*m2;

  if m1=m2 then
  begin
    if b1<>b2 then
    result:=false;
    exit;
  end;

  r.x:=(b1-b2)/(m2-m1);
  r.y:=m1*r.x+b1;

  if InRange(r.x,Min(ps1.x,pe1.x),Max(ps1.x,pe1.x)) then
  if InRange(r.y,Min(ps2.y,pe2.y),Max(ps2.y,pe2.y)) then
  exit;

  result:=false;
end;

function LineWithSphere(p1,p2,RPos:TPoint2; R:Real; out r1,r2:TPoint2)
:integer;
var
pv,pd:TPoint2;
l,b,c,D,l1,l2:double;
intersects1,intersects2,intersects:boolean;
begin
  result:=0;
  if not LineOverlapRect(p1,p2,Bounds2(rpos.x-r,rpos.y-r,r*2,r*2))
    then
  exit;
  r1:=Point2(0,0);
  r2:=Point2(0,0);
  L:=LineLength(p1.x,p1.y,p2.x,p2.y);
  pv:=VecNorm2(VecSub2(p2,p1));
  pd:=VecSub2(p1,RPos);
  b := 2 * (pd.x * pv.x + pd.y * pv.y);
  c := pd.x * pd.x + pd.y * pd.y - R * R;
  D:=b*b-c*4;
  if D<0 then
  begin
    result:=0;
    exit;
  end;
  D:=sqrt(D);
  l1 := ( - b + D) * 0.5;
  l2 := ( - b - D) * 0.5;
  intersects1 := ((l1 >= 0.0) and (l1 <= L));
  intersects2 := ((l2 >= 0.0) and (l2 <= L));
  intersects := intersects1 and intersects2;
  r1.x := p1.x + pv.x * l1;
  r1.y := p1.y + pv.y * l1;
  r2.x := p1.x + pv.x * l2;
  r2.y := p1.y + pv.y * l2;
  if intersects then
  result:=2
  else
  if intersects1 or intersects2 then
  result:=1;
end;

function LineWithQuad(p1,p2:TPoint2; Quad:TPoint4; out r1,r2:TPoint2):integer;
var
i:integer;
begin
  i:=0;
  if LineWithLine(p1,p2,Quad[0],Quad[1],r1) then
  inc(i);

  if i=1 then
  begin
    if LineWithLine(p1,p2,Quad[1],Quad[2],r2) then
    begin
      result:=2;
      exit;
    end
  end
  else
  if LineWithLine(p1,p2,Quad[1],Quad[2],r1) then
  inc(i);

  if i=1 then
  begin
    if LineWithLine(p1,p2,Quad[2],Quad[3],r2) then
    begin
      result:=2;
      exit;
    end
  end
  else
  if LineWithLine(p1,p2,Quad[2],Quad[3],r1) then
  inc(i);

  if i=1 then
  begin
    if LineWithLine(p1,p2,Quad[3],Quad[0],r2) then
    begin
      result:=2;
      exit;
    end
  end
  else
  if LineWithLine(p1,p2,Quad[3],Quad[0],r1) then
  inc(i);

  result:=i;
end;

function SphereWithRect(x1,y1,r:real;FRect2:TRect2):boolean;
var
outp1,outp2:TPoint2;
begin
  Result:=false;
  if PtInRect2(FRect2,Point2(x1,y1)) then
  begin
     Result:=true;
     exit;
  end;

  if (LineWithSphere(Point2(FRect2.top,FRect2.left),Point2(FRect2.bottom,
    FRect2.left),Point2(x1,y1),r,outp1,outp2)>0) or
     (LineWithSphere(Point2(FRect2.top,FRect2.left),Point2(FRect2.top,
    FRect2.right),Point2(x1,y1),r,outp1,outp2)>0) or
     (LineWithSphere(Point2(FRect2.bottom,FRect2.left),Point2(FRect2.bottom,
    FRect2.right),Point2(x1,y1),r,outp1,outp2)>0) or
     (LineWithSphere(Point2(FRect2.top,FRect2.right),Point2(FRect2.bottom,
    FRect2.right),Point2(x1,y1),r,outp1,outp2)>0) then
  result:=true;
end;

function SphereWithQuad(x1,y1,r:real;Quad:TPoint4):boolean;
var
  outp1, outp2: TPoint2;
  i:integer;
begin
  if PtInQuad(Point2(x1,y1),Quad) then
  begin
     Result:=true;
     exit;
  end;
  for i := 0 to 3 do
  if PtInCircle(Quad[i].x,Quad[i].y,x1,y1,r) then
  begin
    result:=true;
    exit;
  end;
  result:= (LineWithSphere(Point2(Quad[0].x,Quad[0].y),Point2(Quad[1].x,
    Quad[1].y),Point2(x1,y1),r,outp1,outp2)>0) or
     (LineWithSphere(Point2(Quad[1].x,Quad[1].y),Point2(Quad[2].x,
    Quad[2].y),Point2(x1,y1),r,outp1,outp2)>0) or
     (LineWithSphere(Point2(Quad[2].x,Quad[2].y),Point2(Quad[3].x,
    Quad[3].y),Point2(x1,y1),r,outp1,outp2)>0) or
     (LineWithSphere(Point2(Quad[3].x,Quad[3].y),Point2(Quad[0].x,
    Quad[0].y),Point2(x1,y1),r,outp1,outp2)>0);
  result:= (LineWithSphere(Point2(Quad[0].x,Quad[0].y),Point2(Quad[1].x,
    Quad[1].y),Point2(x1,y1),r,outp1,outp2)>0) or
     (LineWithSphere(Point2(Quad[1].x,Quad[1].y),Point2(Quad[2].x,
    Quad[2].y),Point2(x1,y1),r,outp1,outp2)>0) or
     (LineWithSphere(Point2(Quad[2].x,Quad[2].y),Point2(Quad[3].x,
    Quad[3].y),Point2(x1,y1),r,outp1,outp2)>0) or
     (LineWithSphere(Point2(Quad[3].x,Quad[3].y),Point2(Quad[0].x,
    Quad[0].y),Point2(x1,y1),r,outp1,outp2)>0);
end;

function PtInQuad(Pt:TPoint2;Quad:TPoint4):boolean;
var
modP:TPoint2;
i,j:integer;
a:real;
Rect:TRect2;
begin
  Rect:=Rect2(MaxInt,MaxInt,MaxInt,MaxInt);
  a:=GetAngle(Quad[0].x,Quad[0].y,Quad[1].x,Quad[1].y);
  for i := 0 to 3 do
  begin
    modP:=VecSub2(Quad[i],Pt);
    modP:=VecRotate2(modP,(96*2-a)/40.7);
    modP.x:=round(modP.x*100)/100;
    modP.y:=round(modP.y*100)/100;
    Quad[i]:=VecAdd2(Pt,modP);
  end;
  for i := 0 to 3 do
  begin
    if (round(Rect.top)=round(MaxInt))
    or(Rect.top>Quad[i].y) then
    Rect.top:=Quad[i].y;

    if (round(Rect.bottom)=round(Maxint))
    or(Rect.bottom<Quad[i].y) then
    Rect.bottom:=Quad[i].y;

    if (round(Rect.left)=round(MaxInt))
    or(Rect.left>Quad[i].x) then
    Rect.left:=Quad[i].x;

    if (round(Rect.right)=round(MaxInt))
    or(Rect.right<Quad[i].x) then
    Rect.right:=Quad[i].x;
  end;
  Result:=PtInRect2(Rect,Pt);
end;

function DistFromPtToLine(Pt:TPoint2;A,B:TPoint2):real;
var
dx,dy,d:real;
begin
  dx := a.x - b.x;
  dy := a.y - b.y;
  D := dx * (Pt.y - a.y) - dy * (Pt.x - a.x);
  result:=abs(D / sqrt(dx * dx + dy * dy));
end;

function FirstPoint(a,b,c:TPoint2):TPoint2;
begin
  if LineLength(a.x,a.y,c.x,c.y)<LineLength(b.x,b.y,c.x,c.y) then
  Result:=a
  else
  Result:=b;
end;

procedure InitCosinTable;
var
  i: Integer;
begin

  for i:=0 to 255 do
    CosinTable[i] := Cos((i/256)*2*3.14);
end;

function Cos256(i: real): Double;
begin
  Result := CosinTable[round(i) and 255];
end;

function Sin256(i: real): Double;
begin
  Result := CosinTable[round((i+192)) and 255];
end;

function GetAngle(x1,y1,x2,y2:real):real;
var
a:real;
defx,defy:real;
begin
  defx:=x1-x2;
  defy:=y1-y2;
  if defx=0 then
  begin
    if y1>y2 then
    result:=0
    else
    result:=128;
    exit;
  end;
  a:=radtodeg(arctan(defy/defx));

  if (defx<=0)and(defy>0) then
  a:=64-abs(a)*64/90
  else
  if (defx<=0)and(defy<=0) then
  a:=64+abs(a)*64/90
  else
  if (defx>0)and(defy<=0) then
  a:=192-abs(a)*64/90
  else
  if (defx>0)and(defy>0) then
  a:=192+abs(a)*64/90;

  Result:=a;
end;

function CInC(x1,y1,r1,x2,y2,r2:real;Intersect:boolean):boolean;
begin
  if Intersect then
  result:=sqrt(sqr(x1-x2)+sqr(y1-y2))<r1+r2
  else
  result:=sqrt(sqr(x1-x2)+sqr(y1-y2))<abs(r1-r2);
end;

function PtInCircle(x,y,x1,y1,r1:real):boolean;
begin
  result:=sqrt(sqr(x-x1)+sqr(y-y1))<r1
end;

function PtInRect2(Rect:TRect2;P:TPoint2):boolean;
begin
  Result := (P.X >= Rect.Left) and (P.X <= Rect.Right) and (P.Y >= Rect.Top)
    and (P.Y <= Rect.Bottom);
end;

function LineOverlapRect(const Point1, Point2: TPoint2; const Rect: TRect2): Boolean;
var
  flag, flag2: boolean;
begin
if Point1.X<Point2.X then
   flag:=(Point1.X<Rect.Right)and(Point2.X>Rect.Left)
else
   flag:=(Point2.X<Rect.Right)and(Point1.X>Rect.Left);

if Point1.Y<Point2.Y then
   flag2:=(Point1.Y<Rect.Bottom)and(Point2.Y>Rect.Top)
else
   flag2:=(Point2.Y<Rect.Bottom)and(Point1.Y>Rect.Top);
Result:=(Flag)and(Flag2);
end;

function Rect2(left,top,right,bottom:real):TRect2;
begin
  Result.top:=Top;
  Result.left:=left;
  Result.right:=right;
  Result.bottom:=bottom;
end;

function Bounds2(ALeft,ATop,AWidth,AHeight:real):TRect2;
begin
  with Result do
  begin
    Left := ALeft;
    Top := ATop;
    Right := ALeft + AWidth;
    Bottom :=  ATop + AHeight;
  end;
end;

function RectInRect2(const Rect1, Rect2: TRect2): Boolean;
begin
 Result:= (Rect1.Left >= Rect2.Left)and(Rect1.Right <= Rect2.Right)and
  (Rect1.Top >= Rect2.Top)and(Rect1.Bottom <= Rect2.Bottom);
end;

function OverlapRect2(const Rect1, Rect2: TRect2): Boolean;
begin
 Result:= (Rect1.Left < Rect2.Right)and(Rect1.Right > Rect2.Left)and
  (Rect1.Top < Rect2.Bottom)and(Rect1.Bottom > Rect2.Top);
end;

function LineLength(x1,y1,x2,y2:real):real;
begin
  result:=sqrt(sqr(x1-x2)+sqr(y1-y2));
end;

initialization
InitCosinTable;
randomize;

end.
